Lake Champlain Basin Program real-time data

Matthew Vaughan

2021-10-22

Welcome

This website shows real-time data from monitoring programs in Lake Champlain and throughout the Lake Champlain Basin.

All data plots are interactive. Hover over plots to see details on each measurement, or click and drag to zoom in on a section. Additional features can be found at the top right of each plot.

This website is under development. All data is provisional and for educational purposes only.

Lake Champlain level

Lake level data from the past 30 days

Lake level data is shown below for four locations on Lake Champlain. Data is collected by the US Geological Survey.

Turn lake level station layers on and off by clicking them in the legend. To see data from only one lake level station, double-click its name. Double-click again to turn all layers back on.

lake_level_station_info <- "data/lake_level_station_info.csv" %>%
                 read_csv() %>%
                 mutate(gage_number = gage_number %>% # Add leading zero to all gage codes
                                      paste0("0", .)) 

lake_level_day_window <- 30

 param_code <- "62614" # Lake water surface elevation above NGVD 1929, feet
 # param_code <- "62615" # Lake water surface elevation above NAVD 1988, feet
 time_zone <- "America/New_York"

 end <- Sys.Date()
 start <-  end - duration(lake_level_day_window, units = "days")

 lake_level <- lake_level_station_info %>%
  select(c(station, gage_number)) %>%
  mutate(level_data = map(.x = gage_number,
                     .f = ~readNWISuv(siteNumber = .x,
                                      startDate = start,
                                      endDate = end,
                                      parameterCd = param_code,
                                      tz = time_zone) %>%
                           rename(timestamp = dateTime,
                                 elevation_ft = X_62614_00000) %>%
                           select(c(timestamp,
                                    elevation_ft)))) %>%
   unnest(level_data)

 lake_level_together <- lake_level %>%
   mutate(station = station %>%
                 fct_reorder2(timestamp, elevation_ft)) %>%
    ggplot() +
    geom_line(aes(x = timestamp,
                  y = elevation_ft,
                  color = station),
              size = 1,
              alpha = 0.5) +
    scale_color_viridis("Level station",
                        discrete = TRUE) + 
   scale_y_continuous(breaks = pretty_breaks()) +
   scale_x_datetime(breaks = pretty_breaks()) +
   labs(x = "",
        y = "Lake water surface elevation\n(feet above NGVD 1929)") +
   theme(axis.text = element_text(face = "bold",
                            size = 14),
         axis.title = element_text(face = "bold",
                            size = 14),
         legend.text = element_text(face = "bold",
                                    size = 10))
  
ggplotly(lake_level_together) 

Lake Champlain water temperature

Water temperature data is shown below for three locations on Lake Champlain. Data is collected by the US Geological Survey.

Turn temperature station layers on and off by clicking them in the legend. To see data from only one lake temperature station, double-click its name. Double-click again to turn all layers back on.

In degrees Fahrenheit

# gather station info
lake_temp_station_info <- "data/lake_temp_station_info.csv" %>%
                 read_csv() %>%
                 mutate(gage_number = gage_number %>% # Add leading zero to all gage codes
                                      paste0("0", .)) 
# enter plot window duration
lake_temp_day_window <- 30
# set start and end dates
 end <- Sys.Date()
 start <-  end - duration(lake_temp_day_window, units = "days")

# USGS parameter code and time zone
 param_code <- "00010" # water temperature in degC
 time_zone <- "America/New_York"

# gather data and create tibble
 lake_temp <- lake_temp_station_info %>%
  select(c(station, gage_number)) %>%
  mutate(temp_data = map(.x = gage_number,
                     .f = ~readNWISuv(siteNumber = .x,
                                      startDate = start,
                                      endDate = end,
                                      parameterCd = param_code,
                                      tz = time_zone) %>%
                           rename(timestamp = dateTime,
                                 water_temp_degC = X_00010_00000) %>%
                           select(c(timestamp,
                                    water_temp_degC)))) %>%
   unnest(temp_data) %>%
   mutate(water_temp_degF = water_temp_degC %>% # create column for Fahrenheit
                            celsius.to.fahrenheit())

# plot water temps in deg F
 lake_temp_together_degF <- lake_temp %>%
   mutate(station = station %>%
                 fct_reorder2(timestamp, water_temp_degF)) %>%
    ggplot() +
    geom_line(aes(x = timestamp,
                  y = water_temp_degF,
                  color = station),
              size = 1,
              alpha = 0.5) +
    scale_color_viridis("Temperature station",
                        discrete = TRUE) + 
   scale_y_continuous(breaks = pretty_breaks()) +
   scale_x_datetime(breaks = pretty_breaks()) +
   labs(x = "",
        y = "Lake water temperature\n(Degrees F)") +
   theme(axis.text = element_text(face = "bold",
                            size = 14),
         axis.title = element_text(face = "bold",
                            size = 14),
         legend.text = element_text(face = "bold",
                                    size = 10))
  
ggplotly(lake_temp_together_degF) 

In degrees Celsius

# plot water temps in deg C
 lake_temp_together_degC <- lake_temp %>%
   mutate(station = station %>%
                 fct_reorder2(timestamp, water_temp_degC)) %>%
    ggplot() +
    geom_line(aes(x = timestamp,
                  y = water_temp_degC,
                  color = station),
              size = 1,
              alpha = 0.5) +
    scale_color_viridis("Temperature station",
                        discrete = TRUE) + 
   scale_y_continuous(breaks = pretty_breaks()) +
   scale_x_datetime(breaks = pretty_breaks()) +
   labs(x = "",
        y = "Lake water temperature\n(Degrees C)") +
   theme(axis.text = element_text(face = "bold",
                            size = 14),
         axis.title = element_text(face = "bold",
                            size = 14),
         legend.text = element_text(face = "bold",
                                    size = 10))

ggplotly(lake_temp_together_degC) 

Lake Champlain tributaries

Tributary discharge data from the past 30 days

Discharge (volume of water per time) data is shown below for 19 major tributaries of Lake Champlain. Data is collected by the US Geological Survey.

Turn tributary layers on and off by clicking them in the legend. To see data from only one tributary, double-click its name. Double-click again to turn all layers back on.

In cubic feet per second

trib_station_info <- "data/trib_station_info.csv" %>%
                 read_csv() %>%
                 mutate(gage_number = gage_number %>% # Add leading zero to all gage codes
                                      paste0("0", .)) 

trib_day_window <- 30

 param_code <- "00060" # discharge in cfs
 time_zone <- "America/New_York"

 end <- Sys.Date()
 start <-  end - duration(trib_day_window, units = "days")

 tribq <- trib_station_info %>%
  select(c(trib, gage_number)) %>%
  mutate(qdata = map(.x = gage_number,
                     .f = ~readNWISuv(siteNumber = .x,
                                      startDate = start,
                                      endDate = end,
                                      parameterCd = param_code,
                                      tz = time_zone) %>%
                           rename(timestamp = dateTime,
                                              discharge_cfs = X_00060_00000) %>%
                           mutate(discharge_cms = discharge_cfs * 0.0283168) %>%
                           select(c(timestamp,
                                    discharge_cfs,
                                    discharge_cms)))) %>%
   unnest(qdata) %>%
   filter(!(timestamp == ymd_hms("2021-09-01 05:30:00", tz = "EDT") &
           trib == "Mettawee")) # remove erroneous value

 tribq_together_cfs <- tribq %>%
   mutate(trib = trib %>%
                 fct_reorder2(timestamp, discharge_cms)) %>%
    ggplot() +
    geom_line(aes(x = timestamp,
                  y = discharge_cfs,
                  color = trib),
              size = 1,
              alpha = 0.5) +
    scale_color_viridis("Tributary",
                        discrete = TRUE) + 
   labs(x = "",
        y = "Discharge (cubic feet per second)") +
   theme(axis.text = element_text(face = "bold",
                            size = 14),
         axis.title = element_text(face = "bold",
                            size = 14),
         legend.text = element_text(face = "bold",
                                    size = 10))
  
ggplotly(tribq_together_cfs)
# Sum discharges together by timestamp
combined_q <- tribq %>%
  select(!c(trib, gage_number)) %>%
  group_by(timestamp) %>%
  summarise(total_discharge_cms = sum(discharge_cms),
            total_discharge_cfs = sum(discharge_cfs),
            n = n()) %>%
  filter(!n < max(n)) # remove timestamps that don't include all tribs
  
n_combined_tribs <- combined_q %>%
           pull("n") %>%
           max()

In cubic meters per second

 tribq_together_cms <- tribq %>%
   mutate(trib = trib %>%
                 fct_reorder2(timestamp, discharge_cms)) %>%
    ggplot() +
    geom_line(aes(x = timestamp,
                  y = discharge_cms,
                  color = trib),
              size = 1,
              alpha = 0.5) +
    scale_color_viridis("Tributary",
                        discrete = TRUE) + 
   labs(x = "",
        y = "Discharge (cubic meters per second)") +
   theme(axis.text = element_text(face = "bold",
                            size = 14),
         axis.title = element_text(face = "bold",
                            size = 14),
         legend.text = element_text(face = "bold",
                                    size = 10))
  
ggplotly(tribq_together_cms)

Map of major tributary discharge monitoring locations

# load mapping packages
library(mapboxapi)
library(leaflet)
# library(sf)

# define buoy location
station_loc <- "data/trib_station_info.csv" %>%
                 read_csv()

# subbasins_poly <- "data/lcb_subbasin_shapefile/LCB_2013_subbasins.shp" %>%
#                   st_read()
# create the map
station_loc %>%
  leaflet() %>%
  addProviderTiles("Esri.WorldImagery") %>%
  # addPolygons(data = subbasins_poly) %>%
  addMarkers(lng = ~lng,
             lat = ~lat,
             label = ~trib)

Total measured discharge from the past 30 days

The plot below shows the total measured discharge (volume of water per time) delivered to Lake Champlain from the 19 tributaries listed above. Note that there are tributaries and direct-to-lake sources of water that are not monitored and/or not included in this plot.

In cubic feet per second

combined_q_plot_cfs <- combined_q %>%
  ggplot() +
  geom_line(aes(x = timestamp, y = total_discharge_cfs)) +
  labs(x = "",
        y = paste("Total measured discharge\n(cubic feet per second)")) +
  theme(axis.text = element_text(face = "bold",
                            size = 14),
        axis.title = element_text(face = "bold",
                            size = 12),
        legend.text = element_text(face = "bold",
                                    size = 10))

ggplotly(combined_q_plot_cfs)

In cubic meters per second

combined_q_plot_cms <- combined_q %>%
  ggplot() +
  geom_line(aes(x = timestamp, y = total_discharge_cms)) +
  labs(x = "",
        y = paste("Total measured discharge\n(cubic meters per second)")) +
  theme(axis.text = element_text(face = "bold",
                            size = 14),
        axis.title = element_text(face = "bold",
                            size = 12),
        legend.text = element_text(face = "bold",
                                    size = 10))

ggplotly(combined_q_plot_cms)

Valcour buoy (not currently deployed)

The Valcour monitoring buoy has been removed for the 2021 season. It will be re-deployed in spring 2022. Late 2021 data is shown below for educational purposes only.

The Valcour monitoring buoy is located in the Main Lake segment of Lake Champlain, near Valcour Island.

# load mapping packages
library(mapboxapi)
library(leaflet)

# define buoy location
buoy_loc <- tibble(lng = -73.394119,
                   lat = 44.602322,
                   name = "Valcour buoy")

# create the map
buoy_loc %>%
  leaflet() %>%
  addProviderTiles("Esri.WorldImagery") %>%
  setView(lng = buoy_loc$lng,
          lat =  buoy_loc$lat,
          zoom = 9) %>%
  addMarkers(lng = ~lng,
             lat = ~lat,
             label = ~name)

Latest weather conditions, recorded 2021-09-29 10:15:00

Air temperature: 12.1 degrees Celsius (53.8 degrees Fahrenheit)

Wind speed: 1.6 meters per second (3.6 miles per hour)

Wind direction: 293 degrees from North

Relative atmospheric pressure: 101.9 kilopascals (764.5 millimeters of mercury; 30.1 inches of mercury)

Weather conditions from the latest 30 days:

In imperial units

valcour_weather_plot_imperial <- valcour %>%
 select(-starts_with("temp")) %>% # select all non-temperature columns
 select(c(timestamp,
          air_temp_degF,
          wind_speed_mph,
          wind_direction_deg,
          rel_atm_pressure_inHg)) %>% # select parameters with the correct units
 pivot_longer(-timestamp,
              names_to = "var",
              values_to = "value") %>%
  filter(!(timestamp == ymd_hms("2021-07-06 03:30:00"))) %>% # remove erroneous value
  filter(!(timestamp == ymd_hms("2021-09-07 16:15:00"))) %>% # remove erroneous value
  mutate(var = var %>%
               recode(air_temp_degF = "Air temperature (degrees Fahrenheit)",
                      wind_speed_mph = "Wind speed (miles per hour)",
                      wind_direction_deg = "Wind direction (degrees from North)",
                      rel_atm_pressure_inHg = "Relative atmospheric pressure (inch of mercury)")) %>%
  ggplot() +
  geom_line(aes(x = timestamp,
                y = value,
                color = var)) +
  facet_wrap(var ~ .,
             scales = "free_y",
             ncol = 1,
             strip.position = "top") +
  scale_color_viridis(discrete = TRUE) +
  theme(legend.position = "none",
        text = element_text(face = "bold",
                                  size = 14)) +
  labs(x = "", y = "")

ggplotly(valcour_weather_plot_imperial)

In metric units

valcour_weather_plot_metric <- valcour %>%
 select(-starts_with("temp")) %>% # select all non-temperature columns
 select(c(timestamp,
          air_temp_degC,
          wind_speed_mps,
          wind_direction_deg,
          rel_atm_pressure_kPa)) %>% # select parameters with the correct units
 pivot_longer(-timestamp,
              names_to = "var",
              values_to = "value") %>%
  filter(!(timestamp == ymd_hms("2021-07-06 03:30:00"))) %>% # remove erroneous value
  filter(!(timestamp == ymd_hms("2021-09-07 16:15:00"))) %>% # remove erroneous value
  mutate(var = var %>%
               recode(air_temp_degC = "Air temperature (degrees Celsius)",
                      wind_speed_mps = "Wind speed (meters per second)",
                      wind_direction_deg = "Wind direction (degrees from North)",
                      rel_atm_pressure_kPa = "Relative atmospheric pressure (kilopascals)")) %>%
  ggplot() +
  geom_line(aes(x = timestamp,
                y = value,
                color = var)) +
  facet_wrap(var ~ .,
             scales = "free_y",
             ncol = 1,
             strip.position = "top") +
  scale_color_viridis(discrete = TRUE) +
  theme(legend.position = "none",
        text = element_text(face = "bold",
                                  size = 14)) +
  labs(x = "", y = "")

ggplotly(valcour_weather_plot_metric)
# Turned off for now while the buoy is out of the water. When buoy is back, paste the following text above this chunk:
## Latest water temperature profile, recorded `r latest_timestamp` {.tabset}

### In imperial units

latest_valcour_watertemp_plot_imperial <- valcour_watertemp %>%
  filter(timestamp == latest_timestamp) %>%
  ggplot() +
  geom_line(aes(x = degF,
                y = depth_ft),
            size = 1.5) +
  scale_y_reverse() +
  labs(x = "Temperature (deg F)",
       y = "Depth below water surface (ft)") +
  theme(text = element_text(face = "bold",
                            size = 14))

ggplotly(latest_valcour_watertemp_plot_imperial)
# Turned off for now while the buoy is out of the water. When buoy is back, paste the following text above this chunk:

### In metric units

latest_valcour_watertemp_plot_metric <- valcour_watertemp %>%
  filter(timestamp == latest_timestamp) %>%
  ggplot() +
  geom_line(aes(x = degC,
                y = depth_m),
            size = 1.5) +
  scale_y_reverse() +
  labs(x = "Temperature (deg C)",
       y = "Depth below water surface (m)") +
  theme(text = element_text(face = "bold",
                            size = 14))

ggplotly(latest_valcour_watertemp_plot_metric)
# Turned off for now. 
# enter number of days to look back:
day_window <- 3

timestamp_labeller <- function(x){
  as.POSIXct(x, origin = '1970-01-01')
}

window_valcour_watertemp_plot <- valcour_watertemp %>%
  filter(timestamp > (latest_timestamp - duration(day_window, units = "days"))) %>%
  ggplot() +
  geom_line(aes(x = degC,
                y = depth_m,
                color = timestamp,
                group = timestamp),
            alpha = 0.4,
            size = 1) +
  scale_y_reverse() +
  scale_color_viridis(option = "magma",
                      direction = -1,
                      labels = timestamp_labeller) +
  labs(x = "Temperature (deg C)",
       y = "Depth below water surface (m)")

ggplotly(window_valcour_watertemp_plot)

Water temperature data from the latest 30 days:

In imperial units

valcour_watertemp_plot_imperial <- valcour_watertemp %>%
  ggplot() +
  geom_tile(aes(x = timestamp,
                y = depth_ft,
                fill = degF)) +
  scale_fill_viridis("Temperature\n(deg F)",
                     option = "plasma") +
  scale_y_reverse() +
  labs(x = "",
       y = "Depth below water surface (ft)") +
  theme(text = element_text(face = "bold",
                            size = 14))

ggplotly(valcour_watertemp_plot_imperial)

In metric units

valcour_watertemp_plot_metric <- valcour_watertemp %>%
  ggplot() +
  geom_tile(aes(x = timestamp,
                y = depth_m,
                fill = degC)) +
  scale_fill_viridis("Temperature\n(deg C)",
                     option = "plasma") +
  scale_y_reverse() +
  labs(x = "",
       y = "Depth below water surface (m)") +
  theme(text = element_text(face = "bold",
                            size = 14))

ggplotly(valcour_watertemp_plot_metric)

More information

Lake Champlain monitoring buoys are supported by the Lake Champlain Basin Program, in partnership with New York and Vermont Departments of Environmental Conservation and SUNY Plattsburgh.

Two additional buoys will be deployed in Lake Champlain and added to this website in 2022.

This website was developed by Matthew Vaughan, Chief Scientist at the Lake Champlain Basin Program. Please contact Matthew for more information.